home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / hippie-exp.el < prev    next >
Text File  |  1993-07-17  |  32KB  |  849 lines
  1. ;;; hippie-exp.el --- expand text trying various ways to find its expansion.
  2.  
  3. ;; Author: Anders Holst <aho@sans.kth.se>
  4. ;; Last change: 22 June 1993
  5. ;; Version: 1.2
  6. ;; Keywords: extensions
  7.  
  8. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  9. ;;
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. ;;; Commentary:
  27. ;;  
  28. ;;  `hippie-expand' is a single function for a lot of different kinds
  29. ;;  of completions and expansions.  Called repeatedly it tries all
  30. ;;  possible completions in succession. 
  31. ;;  Which kinds of completions to try, and in which order, is
  32. ;;  determined by the contents of `hippie-expand-try-functions-list'.
  33. ;;  Much customization of `hippie-expand' can be made by changing the
  34. ;;  order of, removing, or inserting new functions in this list.
  35. ;;  Given a positive numeric argument, `hippie-expand' jumps directly
  36. ;;  ARG functions forward in this list.  Given some other argument
  37. ;;  (a negative argument or just Ctrl-U) it undoes the tried
  38. ;;  completion.
  39. ;;  If the variable `hippie-expand-verbose' is non-nil, `hippie-expand'
  40. ;;  outputs in a message which try-function in the list that is used
  41. ;;  currently (ie. was used currently and will be tried first the next
  42. ;;  time).
  43. ;;  The variable `hippie-expand-max-buffers' determines in how many
  44. ;;  buffers, apart from the current, to search for expansions in.  It
  45. ;;  is used by the try-functions named "-all-buffers".
  46. ;;  See also the macro `make-hippie-expand-function' below.
  47. ;;  
  48. ;;  A short description of the current try-functions in this file:
  49. ;;    `try-complete-file-name' : very convenient to have in any buffer,
  50. ;;      and not just in the minibuffer or (some) shell-mode.  It goes
  51. ;;      through all possible completions instead of just completing as
  52. ;;      much as is unique.
  53. ;;    `try-complete-file-name-partially' : To insert in the list just
  54. ;;      before `try-complete-file-name' for those who want first to get
  55. ;;      a file name completed only as many characters as is unique.
  56. ;;    `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
  57. ;;      Otherwise it looks through all abbrev-tables, starting with
  58. ;;      the local followed by the global. 
  59. ;;    `try-expand-line' : Searches the buffer for an entire line that 
  60. ;;      begins exactly as the current line.  Convenient sometimes, for 
  61. ;;      example as a substitute for (or complement to) the history
  62. ;;      list in shell-like buffers.  At other times, only confusing.
  63. ;;    `try-expand-line-all-buffers' : Like `try-expand-line' but searches
  64. ;;      in all buffers (except the current).  (This may be a little
  65. ;;      slow, don't use it unless you are really fond of `hippie-expand'.)
  66. ;;    `try-expand-list' : Tries to expand the text back to the nearest
  67. ;;      open delimiter, to a whole list from the buffer. Convenient for
  68. ;;      example when writing lisp or TeX.
  69. ;;    `try-expand-list-all-buffers' : Like `try-expand-list' but searches 
  70. ;;      in all buffers (except the current).  
  71. ;;    `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
  72. ;;      course in a way compatible with the other try-functions).
  73. ;;    `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
  74. ;;      like `dabbrev-expand' but searches all Emacs buffers (except the
  75. ;;      current) for matching words.  (No, I don't find this one
  76. ;;      particularly slow.) 
  77. ;;    `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
  78. ;;      through all possibilities instead of completing what is unique.
  79. ;;      Might be tedious (usually a lot of possible completions) and
  80. ;;      since its function is much like `lisp-complete-symbol', which
  81. ;;      already has a key of its own, you might want to remove this.
  82. ;;    `try-complete-lisp-symbol-partially' : To insert in the list just
  83. ;;      before `try-complete-lisp-symbol' for those who first want to get
  84. ;;      completion of what is unique in the name.  
  85. ;;
  86. ;;  Not all of the above functions are by default in
  87. ;;  `hippie-expand-try-functions-list'.  This variable is better set
  88. ;;  in ".emacs" to make `hippie-expand' behave maximally convenient
  89. ;;  according to personal taste.  Also, instead of loading the
  90. ;;  variable with all kinds of try-functions above, it might be an
  91. ;;  idea to use `make-hippie-expand-function' to construct different
  92. ;;  `hippie-expand'-like functions, with different try-lists and bound
  93. ;;  to different keys. It is also possible to make
  94. ;;  `hippie-expand-try-functions-list' a buffer local variable, and
  95. ;;  let it depend on the mode (by setting it in the mode-hooks).
  96. ;;
  97. ;;  To write new try-functions, consider the following:
  98. ;;  Each try-function takes one argument OLD which is nil the first
  99. ;;  time the function is called and true in succeeding calls for the
  100. ;;  same string to complete.  The first time the function has to
  101. ;;  extract the string before point to complete, and substitute the
  102. ;;  first completion alternative for it.  On following calls it has to
  103. ;;  substitute the next possible completion for the last tried string.
  104. ;;  The try-function is to return t as long as it finds new
  105. ;;  possible completions.  When there are no more alternatives it has
  106. ;;  to restore the text before point to its original contents, and
  107. ;;  return nil (don't beep or message or anything).
  108. ;;  The try-function can (should) use the following functions:
  109. ;;    `he-init-string' : Initializes the text to substitute to the
  110. ;;      contents of the region BEGIN to END.  Also sets the variable
  111. ;;      `he-search-string' to the text to expand.
  112. ;;    `he-substitute-string' : substitutes STR into the region
  113. ;;      initialized with `he-init-string'.  (An optional second argument
  114. ;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
  115. ;;      to the expansion is ok if that is enabled in the buffer.)
  116. ;;    `he-reset-string' : Resets the initialized region to its original
  117. ;;      contents.
  118. ;;  There is also a variable: `he-tried-table' which is meant to contain
  119. ;;  all tried expansions so far.  The try-function can check this 
  120. ;;  variable to see whether an expansion has already been tried
  121. ;;  (hint: `he-string-member'), and add its own tried expansions to it.
  122. ;;
  123. ;;  Known bugs
  124. ;;
  125. ;;  It may happen that some completion suggestion occurs twice, in
  126. ;;  spite of the use of `he-tried-table' to prevent that.  This is 
  127. ;;  because different try-functions may try to complete different
  128. ;;  lengths of text, and thus put different amounts of the
  129. ;;  text in `he-try-table'.  Anyway this seems to occur seldom enough not
  130. ;;  to be too disturbing.  Also it should NOT bee possible for the
  131. ;;  opposite situation to occur, that `hippie-expand' misses some
  132. ;;  suggestion because it thinks it has already tried it.
  133. ;;
  134. ;;  Acknowledgement
  135. ;;
  136. ;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
  137. ;;  of this function took form.
  138. ;;  I am also grateful to all those who have given me suggestions on
  139. ;;  how to improve it.
  140. ;;
  141.  
  142. ;;; Code:
  143.  
  144. (defvar he-num -1)
  145.  
  146. (defvar he-string-beg (make-marker))
  147.  
  148. (defvar he-string-end (make-marker))
  149.  
  150. (defvar he-search-string ())
  151.  
  152. (defvar he-expand-list ())
  153.  
  154. (defvar he-tried-table ())
  155.  
  156. (defvar he-search-loc (make-marker))
  157.  
  158. (defvar he-search-bw ())
  159.  
  160. (defvar he-search-bufs ())
  161.  
  162. (defvar he-searched-n-bufs ())
  163.  
  164. ;;;###autoload
  165. (defvar hippie-expand-try-functions-list '(try-complete-file-name
  166.                        try-expand-all-abbrevs
  167.                        try-expand-line
  168.                        try-expand-dabbrev
  169.                        try-expand-dabbrev-all-buffers
  170.                        try-complete-lisp-symbol)
  171.   "The list of expansion functions tried in order by `hippie-expand'.
  172. To change the behavior of `hippie-expand', remove, change the order of,
  173. or insert functions in this list.")
  174.  
  175. ;;;###autoload
  176. (defvar hippie-expand-verbose t
  177.   "*Non-nil makes `hippie-expand' output which function it is trying.")
  178.  
  179. ;;;###autoload
  180. (defvar hippie-expand-max-buffers ()
  181.   "*The maximum number of buffers (apart from the current) searched.
  182. If nil, all buffers are searched.")
  183.  
  184. ;;;###autoload
  185. (defun hippie-expand (arg)
  186.   "Try to expand text before point, using multiple methods.
  187. The expansion functions in `hippie-expand-try-functions-list' are
  188. tried in order, until a possible expansion is found.  Repeated
  189. application of `hippie-expand' inserts successively possible
  190. expansions.  
  191. With a positive numeric argument, jumps directly to the ARG next
  192. function in this list.  With a negative argument or just \\[universal-argument], 
  193. undoes the expansion." 
  194.   (interactive "P")
  195.   (if (or (not arg) 
  196.       (and (integerp arg) (> arg 0)))
  197.       (let ((first (or (= he-num -1)
  198.                (not (equal this-command last-command)))))
  199.     (if first
  200.         (progn
  201.           (setq he-num -1)
  202.           (setq he-tried-table nil)))
  203.     (if arg
  204.         (if (not first) (he-reset-string))
  205.         (setq arg 0))
  206.     (let ((i (max (+ he-num arg) 0)))
  207.       (while (not (or (>= i (length hippie-expand-try-functions-list))
  208.               (apply (nth i hippie-expand-try-functions-list) 
  209.                  (list (= he-num i)))))
  210.         (setq i (1+ i)))
  211.       (setq he-num i))
  212.     (if (>= he-num (length hippie-expand-try-functions-list))
  213.         (progn
  214.           (setq he-num -1)
  215.           (if first
  216.           (message "No expansion found")
  217.           (message "No further expansions found"))
  218.           (ding))
  219.         (if (and hippie-expand-verbose
  220.                      (not (window-minibuffer-p (selected-window))))
  221.         (message (concat "Using "
  222.                  (prin1-to-string (nth he-num 
  223.                    hippie-expand-try-functions-list)))))))
  224.       (if (>= he-num 0)
  225.       (progn
  226.         (setq he-num -1)
  227.         (he-reset-string)
  228.         (if (and hippie-expand-verbose
  229.                      (not (window-minibuffer-p (selected-window))))
  230.         (message "Undoing expansions"))))))
  231.  
  232. ;; Initializes the region to expand (to between BEG and END).
  233. (defun he-init-string (beg end)
  234.   (set-marker he-string-beg beg)
  235.   (set-marker he-string-end end)
  236.   (setq he-search-string (buffer-substring beg end)))
  237.  
  238. ;; Resets the expanded region to its original contents.
  239. (defun he-reset-string ()
  240.   (let ((newpos (point-marker)))
  241.     (delete-region he-string-beg he-string-end)
  242.     (goto-char he-string-beg)
  243.     (insert he-search-string)
  244.     (set-marker he-string-end (point))
  245.     (if (= newpos he-string-beg)
  246.     (goto-char he-string-end)
  247.     (goto-char newpos))))
  248.  
  249. ;; Substitutes an expansion STR into the correct region (the region
  250. ;; initialized with `he-init-string'). 
  251. ;; An optional argument TRANS-CASE means that it is ok to transfer case
  252. ;; from the abbreviation to the expansion if that is possible, and is
  253. ;; enabled in the buffer.
  254. (defun he-substitute-string (str &optional trans-case)
  255.   (let ((trans-case (and trans-case
  256.              case-replace
  257.              case-fold-search
  258.              (he-transfer-case-ok str he-search-string)))
  259.     (newpos (point-marker)))
  260.     (he-reset-string)
  261.     (goto-char he-string-beg)
  262.     (search-forward he-search-string)
  263.     (replace-match (if trans-case (downcase str) str)
  264.            (not trans-case)
  265.            'literal)
  266.     (set-marker he-string-end (point))
  267.     (if (= newpos he-string-beg)
  268.     (goto-char he-string-end)
  269.     (goto-char newpos))))
  270.  
  271. (defun he-ordinary-case-p (str)
  272.   (or (string= str (downcase str))
  273.       (string= str (upcase str))
  274.       (string= str (capitalize str))))
  275.  
  276. (defun he-transfer-case-ok (to-str from-str)
  277.   (and (not (string= from-str (substring to-str 0 (min (length from-str)
  278.                                                        (length to-str)))))
  279.          ;; otherwise transfer is not needed (and this also solves
  280.      ;; some obscure situations)
  281.        (he-ordinary-case-p to-str)
  282.          ;; otherwise case may be significant 
  283.        (he-ordinary-case-p from-str)
  284.          ;; otherwise replace-match wont know what to do
  285.   ))
  286.  
  287. ;; Check if STR is a member of LST.
  288. ;; Ignore case if `case-replace' and `case-fold-search' are both t.
  289. (defun he-string-member (str lst)
  290.   (while (and lst
  291.           (not
  292.            (if (and case-fold-search case-replace)
  293.            (string= (downcase (car lst)) (downcase str))
  294.            (string= (car lst) str))))
  295.     (setq lst (cdr lst)))
  296.   lst)
  297.  
  298. ;;  For the real hippie-expand enthusiast: A macro that makes it
  299. ;;  possible to use many functions like hippie-expand, but with
  300. ;;  different try-functions-lists.
  301. ;;  Usage is for example:
  302. ;;    (fset 'my-complete-file (make-hippie-expand-function
  303. ;;                             '(try-complete-file-name-partially
  304. ;;                               try-complete-file-name)))
  305. ;;    (fset 'my-complete-line (make-hippie-expand-function
  306. ;;                             '(try-expand-line
  307. ;;                               try-expand-line-all-buffers)))
  308. ;;  
  309. ;;;###autoload
  310. (defmacro make-hippie-expand-function (try-list &optional verbose)
  311.   "Construct a function similar to `hippie-expand'.
  312. Make it use the expansion functions in TRY-LIST.  An optional second
  313. argument VERBOSE non-nil makes the function verbose."
  314.   (` (function (lambda (arg)
  315.        (, (concat 
  316.            "Try to expand text before point, using the following functions: \n"
  317.        (mapconcat 'prin1-to-string (eval try-list) ", ")))
  318.        (interactive "P")
  319.        (let ((hippie-expand-try-functions-list (, try-list))
  320.          (hippie-expand-verbose (, verbose)))
  321.      (hippie-expand arg))))))
  322.  
  323.  
  324. ;;;  Here follows the try-functions and their requisites:
  325.  
  326. (defun try-complete-file-name (old)
  327.   "Try to complete text as a file name.
  328. The argument OLD has to be nil the first call of this function, and t
  329. for subsequent calls (for further possible completions of the same
  330. string).  It returns t if a new completion is found, nil otherwise."
  331.   (if (not old)
  332.       (progn 
  333.     (he-init-string (he-file-name-beg) (point))
  334.     (let ((name-part (file-name-nondirectory he-search-string))
  335.           (dir-part (expand-file-name (or (file-name-directory
  336.                            he-search-string) ""))))
  337.       (if (not (he-string-member name-part he-tried-table))
  338.           (setq he-tried-table (cons name-part he-tried-table)))
  339.       (if (and (not (equal he-search-string ""))
  340.            (file-directory-p dir-part))
  341.           (setq he-expand-list (sort (file-name-all-completions 
  342.                       name-part
  343.                       dir-part)
  344.                      'string-lessp))
  345.           (setq he-expand-list ())))))
  346.  
  347.   (while (and he-expand-list
  348.           (he-string-member (car he-expand-list) he-tried-table))
  349.     (setq he-expand-list (cdr he-expand-list)))
  350.   (if (null he-expand-list)
  351.       (progn
  352.         (if old (he-reset-string))
  353.     ())
  354.       (let ((filename (concat (file-name-directory he-search-string)
  355.                   (car he-expand-list))))
  356.     (he-substitute-string filename)
  357.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  358.     (setq he-expand-list (cdr he-expand-list))
  359.     t)))
  360.  
  361. (defun try-complete-file-name-partially (old)
  362.   "Try to complete text as a file name, as many characters as unique.
  363. The argument OLD has to be nil the first call of this function.  It
  364. returns t if a unique, possibly partial, completion is found, nil 
  365. otherwise."
  366.   (let ((expansion ()))
  367.     (if (not old)
  368.     (progn 
  369.       (he-init-string (he-file-name-beg) (point))
  370.       (let ((name-part (file-name-nondirectory he-search-string))
  371.         (dir-part (expand-file-name (or (file-name-directory
  372.                          he-search-string) ""))))
  373.         (if (and (not (equal he-search-string ""))
  374.              (file-directory-p dir-part))
  375.         (setq expansion (file-name-completion name-part
  376.                               dir-part)))
  377.         (if (or (eq expansion t)
  378.             (string= expansion name-part))
  379.         (setq expansion ())))))
  380.  
  381.     (if (not expansion)
  382.     (progn
  383.           (if old (he-reset-string))
  384.       ())
  385.     (let ((filename (concat (file-name-directory he-search-string)
  386.                 expansion)))
  387.       (he-substitute-string filename)
  388.       (setq he-tried-table (cons expansion he-tried-table))
  389.       t))))
  390.  
  391. (defun he-file-name-beg ()
  392.   (let ((skips "-a-zA-Z0-9_./~^#$"))
  393.     (save-excursion
  394.       (skip-chars-backward skips)
  395.       (point))))
  396.  
  397. (defun try-complete-lisp-symbol (old)
  398.   "Try to complete word as an Emacs Lisp symbol.
  399. The argument OLD has to be nil the first call of this function, and t
  400. for subsequent calls (for further possible completions of the same
  401. string).  It returns t if a new completion is found, nil otherwise."
  402.   (if (not old)
  403.       (progn 
  404.     (he-init-string (he-lisp-symbol-beg) (point))
  405.     (if (not (he-string-member he-search-string he-tried-table))
  406.         (setq he-tried-table (cons he-search-string he-tried-table)))
  407.     (setq he-expand-list 
  408.           (and (not (equal he-search-string ""))
  409.            (sort (all-completions he-search-string obarray
  410.                       (function (lambda (sym)
  411.                         (or (boundp sym)
  412.                         (fboundp sym)
  413.                         (symbol-plist sym)))))
  414.              'string-lessp)))))
  415.   (while (and he-expand-list
  416.           (he-string-member (car he-expand-list) he-tried-table))
  417.     (setq he-expand-list (cdr he-expand-list)))
  418.   (if (null he-expand-list)
  419.       (progn
  420.         (if old (he-reset-string))
  421.     ())
  422.       (progn
  423.     (he-substitute-string (car he-expand-list))
  424.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  425.     (setq he-expand-list (cdr he-expand-list))
  426.     t)))
  427.  
  428. (defun try-complete-lisp-symbol-partially (old)
  429.   "Try to complete as an Emacs Lisp symbol, as many characters as unique.
  430. The argument OLD has to be nil the first call of this function.  It
  431. returns t if a unique, possibly partial, completion is found, nil 
  432. otherwise."
  433.   (let ((expansion ()))
  434.     (if (not old)
  435.     (progn 
  436.       (he-init-string (he-lisp-symbol-beg) (point))
  437.       (if (not (string= he-search-string ""))
  438.           (setq expansion 
  439.             (try-completion he-search-string obarray
  440.                     (function (lambda (sym)
  441.                       (or (boundp sym)
  442.                       (fboundp sym)
  443.                       (symbol-plist sym)))))))
  444.       (if (or (eq expansion t)
  445.           (string= expansion he-search-string))
  446.           (setq expansion ()))))
  447.  
  448.   (if (not expansion)
  449.       (progn
  450.         (if old (he-reset-string))
  451.     ())
  452.       (progn
  453.     (he-substitute-string expansion)
  454.     (setq he-tried-table (cons expansion he-tried-table))
  455.     t))))
  456.  
  457. (defun he-lisp-symbol-beg ()
  458.   (let ((skips "-a-zA-Z0-9_."))
  459.     (save-excursion
  460.       (skip-chars-backward skips)
  461.       (point))))
  462.  
  463. (defun try-expand-line (old)
  464.   "Try to complete the current line to an entire line in the buffer.
  465. The argument OLD has to be nil the first call of this function, and t
  466. for subsequent calls (for further possible completions of the same
  467. string).  It returns t if a new completion is found, nil otherwise."
  468.   (let ((expansion ())
  469.     (strip-prompt (and (get-buffer-process (current-buffer))
  470.                comint-prompt-regexp)))
  471.     (if (not old)
  472.     (progn
  473.       (he-init-string (he-line-beg strip-prompt) (point))
  474.       (set-marker he-search-loc he-string-beg)
  475.       (setq he-search-bw t)))
  476.  
  477.     (if (not (equal he-search-string ""))
  478.     (save-excursion
  479.       ;; Try looking backward unless inhibited.
  480.       (if he-search-bw
  481.           (progn 
  482.         (goto-char he-search-loc)
  483.         (setq expansion (he-line-search he-search-string
  484.                         strip-prompt t))
  485.         (set-marker he-search-loc (point))
  486.         (if (not expansion)
  487.             (progn
  488.               (set-marker he-search-loc he-string-end)
  489.               (setq he-search-bw ())))))
  490.       
  491.       (if (not expansion) ; Then look forward.
  492.           (progn 
  493.         (goto-char he-search-loc)
  494.         (setq expansion (he-line-search he-search-string 
  495.                         strip-prompt nil))
  496.         (set-marker he-search-loc (point))))))
  497.  
  498.     (if (not expansion)
  499.     (progn
  500.           (if old (he-reset-string))
  501.       ())
  502.     (progn
  503.       (he-substitute-string expansion t)
  504.       (setq he-tried-table (cons expansion he-tried-table))
  505.       t))))
  506.  
  507. (defun try-expand-line-all-buffers (old)
  508.   "Try to complete the current line, searching all other buffers.
  509. The argument OLD has to be nil the first call of this function, and t
  510. for subsequent calls (for further possible completions of the same
  511. string).  It returns t if a new completion is found, nil otherwise."
  512.   (let ((expansion ())
  513.     (strip-prompt (and (get-buffer-process (current-buffer))
  514.                comint-prompt-regexp))
  515.     (buf (current-buffer)))
  516.     (if (not old)
  517.     (progn
  518.       (he-init-string (he-line-beg strip-prompt) (point))
  519.       (setq he-search-bufs (buffer-list))
  520.           (setq he-searched-n-bufs 0)
  521.       (set-marker he-search-loc 1 (car he-search-bufs))))
  522.  
  523.     (if (not (equal he-search-string ""))
  524.     (while (and he-search-bufs 
  525.                     (not expansion)
  526.                     (or (not hippie-expand-max-buffers)
  527.                         (< he-searched-n-bufs hippie-expand-max-buffers)))
  528.       (set-buffer (car he-search-bufs))
  529.       (if (and (not (eq (current-buffer) buf))
  530.                    (not (string-match " \\*Minibuf-[0-9]+\\*"
  531.                                       (buffer-name (current-buffer))))
  532.            (not (eq major-mode 'dired-mode)))
  533.            ;; Dont search minibuffers nor dired buffers
  534.           (save-excursion
  535.         (goto-char he-search-loc)
  536.                 (setq strip-prompt (and (get-buffer-process (current-buffer))
  537.                                         comint-prompt-regexp))
  538.         (setq expansion (he-line-search he-search-string
  539.                         strip-prompt nil))
  540.         (set-marker he-search-loc (point))
  541.                 (if expansion
  542.                     (setq he-tried-table (cons expansion he-tried-table))
  543.                   (setq he-search-bufs (cdr he-search-bufs))
  544.                   (setq he-searched-n-bufs (1+ he-searched-n-bufs))
  545.                   (set-marker he-search-loc 1 (car he-search-bufs))))
  546.             (setq he-search-bufs (cdr he-search-bufs))
  547.             (set-marker he-search-loc 1 (car he-search-bufs)))))
  548.  
  549.     (set-buffer buf)
  550.     (if (not expansion)
  551.     (progn
  552.           (if old (he-reset-string))
  553.       ())
  554.     (progn
  555.       (he-substitute-string expansion t)
  556.       t))))
  557.  
  558. (defun he-line-search (str strip-prompt reverse) 
  559.   (let ((result ()))
  560.     (while (and (not result)
  561.         (if reverse
  562.             (re-search-backward 
  563.              (he-line-search-regexp str strip-prompt)
  564.              nil t)
  565.             (re-search-forward
  566.              (he-line-search-regexp str strip-prompt)
  567.              nil t)))
  568.       (setq result (buffer-substring (match-beginning 2) (match-end 2)))
  569.       (if (he-string-member result he-tried-table)
  570.       (setq result nil)))                ; if already in table, ignore
  571.     result))
  572.  
  573. (defun he-line-beg (strip-prompt)
  574.   (save-excursion
  575.     (end-of-line)
  576.     (if (re-search-backward (he-line-search-regexp "" strip-prompt) 
  577.                 (save-excursion (beginning-of-line)
  578.                         (point)) t)
  579.     (match-beginning 2)
  580.       (beginning-of-line)
  581.       (point))))
  582.  
  583. (defun he-line-search-regexp (pat strip-prompt)
  584.   (if strip-prompt
  585.       (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
  586.           (regexp-quote pat)
  587.           "[^\n]*[^ \t\n]\\)")
  588.       (concat "^\\(\\s-*\\)\\(" 
  589.           (regexp-quote pat)
  590.           "[^\n]*[^ \t\n]\\)")))
  591.  
  592. (defun try-expand-list (old)
  593.   "Try to complete the current beginning of a list.
  594. The argument OLD has to be nil the first call of this function, and t
  595. for subsequent calls (for further possible completions of the same
  596. string).  It returns t if a new completion is found, nil otherwise."
  597.   (let ((expansion ()))
  598.     (if (not old)
  599.     (progn
  600.       (he-init-string (he-list-beg) (point))
  601.       (set-marker he-search-loc he-string-beg)
  602.       (setq he-search-bw t)))
  603.  
  604.     (if (not (equal he-search-string ""))
  605.     (save-excursion
  606.       ;; Try looking backward unless inhibited.
  607.       (if he-search-bw
  608.           (progn 
  609.         (goto-char he-search-loc)
  610.         (setq expansion (he-list-search he-search-string t))
  611.         (set-marker he-search-loc (point))
  612.         (if (not expansion)
  613.             (progn
  614.               (set-marker he-search-loc he-string-end)
  615.               (setq he-search-bw ())))))
  616.       
  617.       (if (not expansion) ; Then look forward.
  618.           (progn 
  619.         (goto-char he-search-loc)
  620.         (setq expansion (he-list-search he-search-string nil))
  621.         (set-marker he-search-loc (point))))))
  622.  
  623.     (if (not expansion)
  624.     (progn
  625.       (if old (he-reset-string))
  626.       ())
  627.     (progn
  628.       (he-substitute-string expansion t)
  629.       (setq he-tried-table (cons expansion he-tried-table))
  630.       t))))
  631.  
  632. (defun try-expand-list-all-buffers (old)
  633.   "Try to complete the current list, searching all other buffers.
  634. The argument OLD has to be nil the first call of this function, and t
  635. for subsequent calls (for further possible completions of the same
  636. string).  It returns t if a new completion is found, nil otherwise."
  637.   (let ((expansion ())
  638.     (buf (current-buffer)))
  639.     (if (not old)
  640.     (progn
  641.       (he-init-string (he-list-beg) (point))
  642.       (setq he-search-bufs (buffer-list))
  643.           (setq he-searched-n-bufs 0)
  644.       (set-marker he-search-loc 1 (car he-search-bufs))))
  645.  
  646.     (if (not (equal he-search-string ""))
  647.     (while (and he-search-bufs 
  648.                     (not expansion)
  649.                     (or (not hippie-expand-max-buffers)
  650.                         (< he-searched-n-bufs hippie-expand-max-buffers)))
  651.       (set-buffer (car he-search-bufs))
  652.       (if (and (not (eq (current-buffer) buf))
  653.                    (not (string-match " \\*Minibuf-[0-9]+\\*"
  654.                                       (buffer-name (current-buffer))))
  655.            (not (eq major-mode 'dired-mode)))
  656.            ;; Dont search minibuffers nor dired buffers
  657.           (save-excursion
  658.         (goto-char he-search-loc)
  659.         (setq expansion (he-list-search he-search-string nil))
  660.         (set-marker he-search-loc (point))
  661.                 (if expansion
  662.                     (setq he-tried-table (cons expansion he-tried-table))
  663.                   (setq he-search-bufs (cdr he-search-bufs))
  664.                   (setq he-searched-n-bufs (1+ he-searched-n-bufs))
  665.                   (set-marker he-search-loc 1 (car he-search-bufs))))
  666.             (setq he-search-bufs (cdr he-search-bufs))
  667.             (set-marker he-search-loc 1 (car he-search-bufs)))))
  668.  
  669.     (set-buffer buf)
  670.     (if (not expansion)
  671.     (progn
  672.           (if old (he-reset-string))
  673.       ())
  674.     (progn
  675.       (he-substitute-string expansion t)
  676.       t))))
  677.  
  678. (defun he-list-search (str reverse) 
  679.   (let ((result ())
  680.         beg pos err)
  681.     (while (and (not result)
  682.         (if reverse
  683.             (search-backward str nil t)
  684.             (search-forward str nil t)))
  685.       (setq pos (point))
  686.       (setq beg (match-beginning 0))
  687.       (goto-char beg)
  688.       (setq err ())
  689.       (condition-case ()
  690.           (forward-list 1)
  691.         (error (setq err t)))
  692.       (if (not err)
  693.           (progn
  694.             (setq result (buffer-substring beg (point)))
  695.             (if (he-string-member result he-tried-table)
  696.                 (setq result nil))))           ; if already in table, ignore
  697.       (goto-char pos))
  698.     result))
  699.  
  700. (defun he-list-beg ()
  701.   (save-excursion
  702.     (condition-case ()
  703.         (backward-up-list 1)
  704.       (error ()))
  705.     (point)))
  706.  
  707. (defun try-expand-all-abbrevs (old)
  708.   "Try to expand word before point according to all abbrev tables.
  709. The argument OLD has to be nil the first call of this function, and t
  710. for subsequent calls (for further possible expansions of the same
  711. string).  It returns t if a new expansion is found, nil otherwise."
  712.   (if (not old)
  713.       (progn
  714.     (he-init-string (he-dabbrev-beg) (point))
  715.     (setq he-expand-list 
  716.           (and (not (equal he-search-string ""))
  717.            (mapcar (function (lambda (sym)
  718.                  (abbrev-expansion (downcase he-search-string)
  719.                            (eval sym))))
  720.                (append '(local-abbrev-table 
  721.                      global-abbrev-table)
  722.                    abbrev-table-name-list))))))
  723.   (while (and he-expand-list
  724.           (or (not (car he-expand-list))
  725.           (he-string-member (car he-expand-list) he-tried-table)))
  726.     (setq he-expand-list (cdr he-expand-list)))
  727.   (if (null he-expand-list)
  728.       (progn
  729.         (if old (he-reset-string))
  730.     ())
  731.       (progn
  732.     (he-substitute-string (car he-expand-list) t)
  733.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  734.     (setq he-expand-list (cdr he-expand-list))
  735.     t)))
  736.  
  737. (defun try-expand-dabbrev (old)
  738.   "Try to expand word \"dynamically\", searching the current buffer.
  739. The argument OLD has to be nil the first call of this function, and t
  740. for subsequent calls (for further possible expansions of the same
  741. string).  It returns t if a new expansion is found, nil otherwise."
  742.   (let ((expansion ()))
  743.     (if (not old)
  744.     (progn
  745.       (he-init-string (he-dabbrev-beg) (point))
  746.       (set-marker he-search-loc he-string-beg)
  747.       (setq he-search-bw t)))
  748.  
  749.     (if (not (equal he-search-string ""))
  750.     (save-excursion
  751.       ;; Try looking backward unless inhibited.
  752.       (if he-search-bw
  753.           (progn 
  754.         (goto-char he-search-loc)
  755.         (setq expansion (he-dab-search he-search-string t))
  756.         (set-marker he-search-loc (point))
  757.         (if (not expansion)
  758.             (progn
  759.               (set-marker he-search-loc he-string-end)
  760.               (setq he-search-bw ())))))
  761.       
  762.       (if (not expansion) ; Then look forward.
  763.           (progn 
  764.         (goto-char he-search-loc)
  765.         (setq expansion (he-dab-search he-search-string nil))
  766.         (set-marker he-search-loc (point))))))
  767.     
  768.     (if (not expansion)
  769.     (progn
  770.           (if old (he-reset-string))
  771.       ())
  772.     (progn
  773.       (he-substitute-string expansion t)
  774.       (setq he-tried-table (cons expansion he-tried-table))
  775.       t))))
  776.  
  777. (defun try-expand-dabbrev-all-buffers (old)
  778.   "Tries to expand word \"dynamically\", searching all other buffers.
  779. The argument OLD has to be nil the first call of this function, and t
  780. for subsequent calls (for further possible expansions of the same
  781. string).  It returns t if a new expansion is found, nil otherwise."
  782.   (let ((expansion ())
  783.     (buf (current-buffer)))
  784.     (if (not old)
  785.     (progn
  786.       (he-init-string (he-dabbrev-beg) (point))
  787.       (setq he-search-bufs (buffer-list))
  788.           (setq he-searched-n-bufs 0)
  789.       (set-marker he-search-loc 1 (car he-search-bufs))))
  790.  
  791.     (if (not (equal he-search-string ""))
  792.     (while (and he-search-bufs 
  793.                     (not expansion)
  794.                     (or (not hippie-expand-max-buffers)
  795.                         (< he-searched-n-bufs hippie-expand-max-buffers)))
  796.       (set-buffer (car he-search-bufs))
  797.       (if (and (not (eq (current-buffer) buf))
  798.                    (not (string-match " \\*Minibuf-[0-9]+\\*"
  799.                                       (buffer-name (current-buffer))))
  800.            (not (eq major-mode 'dired-mode)))
  801.            ;; Dont search minibuffers nor dired buffers
  802.           (save-excursion
  803.         (goto-char he-search-loc)
  804.         (setq expansion (he-dab-search he-search-string nil))
  805.         (set-marker he-search-loc (point))
  806.                 (if expansion
  807.                     (setq he-tried-table (cons expansion he-tried-table))
  808.                   (setq he-search-bufs (cdr he-search-bufs))
  809.                   (setq he-searched-n-bufs (1+ he-searched-n-bufs))
  810.                   (set-marker he-search-loc 1 (car he-search-bufs))))
  811.             (setq he-search-bufs (cdr he-search-bufs))
  812.             (set-marker he-search-loc 1 (car he-search-bufs)))))
  813.  
  814.     (set-buffer buf)
  815.     (if (not expansion)
  816.     (progn
  817.           (if old (he-reset-string))
  818.       ())
  819.     (progn
  820.       (he-substitute-string expansion t)
  821.       t))))
  822.  
  823. (defun he-dab-search-regexp (pat)
  824.   (concat "\\b" (regexp-quote pat) 
  825.       "\\(\\sw\\|\\s_\\)+"))
  826.  
  827. (defun he-dab-search (pattern reverse)
  828.   (let ((result ()))
  829.     (while (and (not result) 
  830.         (if reverse
  831.              (re-search-backward (he-dab-search-regexp pattern)
  832.                      nil t)
  833.              (re-search-forward (he-dab-search-regexp pattern)
  834.                     nil t)))
  835.       (setq result (buffer-substring (match-beginning 0) (match-end 0)))
  836.       (if (he-string-member result he-tried-table)
  837.       (setq result nil)))                ; if already in table, ignore
  838.     result))
  839.  
  840. (defun he-dabbrev-beg ()
  841.   (save-excursion
  842.     (skip-syntax-backward "w_")
  843.     (skip-syntax-forward "_")
  844.     (point)))
  845.  
  846. (provide 'hippie-exp)
  847.  
  848. ;;; hippie-exp.el ends here
  849.